(define (max a b) (if (> a b) a b))
(define (pow n e)
  (if (= e 0)
      1
      (* n (pow n (- e 1)))))

(define (display-times s n)
  (if (> n 0)
      (begin (display s)
             (display-times s (- n 1)))
      #f))

(define (pad dm d left?)
  (let* ((floor (- dm d))
         (padding (- (pow 2 (+ floor (if left? 0 1))) 1)))
    (display-times " " padding)))

(define (partition-levels reflect q d q* out st empty?)
  (if (null? q)
      (if (if empty? #t (null? q*))
          (cons d (st '()))
          (let* ((result (out '())))
            (partition-levels reflect q* (+ d 1) '() (lambda (x) x) (lambda (rest) (st (cons result rest))) #t)))
      (let* ((first (car q))
             (rest (cdr q)))
        ((reflect first)
         (lambda (l v r)
           (let* ((out* (lambda (rest) (out (cons v rest)))))
             (partition-levels reflect rest d (append q* (cons l (cons r '()))) out* st #f)))
         (lambda (null)
           (let* ((out* (lambda (rest) (out (cons "_" rest)))))
             (partition-levels reflect rest d (append q* (cons null (cons null '()))) out* st empty?)))))))

(define (print-levels st d dm)
  (if (< d dm)
      (begin
        (pad dm d #t)
        (display (car (car st)))
        (map (lambda (x)
               (pad dm d #f)
               (display x))
             (cdr (car st)))
        (newline)
        (print-levels (cdr st) (+ d 1) dm))
      #f))

(define (make-tree-printer reflect)
  (lambda (tree)
    (let ((x (partition-levels reflect (cons tree '()) 0 '() (lambda (x) x) (lambda (x) x) #t)))
      (print-levels (cdr x) 0 (car x)))))
